home *** CD-ROM | disk | FTP | other *** search
/ CD Actual 9 / CDACTUAL9.iso / share / Dos / VARIOS / pascal / SWAG9605.DDD / 0127_Another Pickable Litebar Menu.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1996-05-31  |  1.8 KB  |  84 lines
  1. {============================================================================}
  2.  
  3. PROGRAM LightBar;
  4. uses Crt;
  5.  
  6. const
  7.  
  8.    UPARROW  = #72;
  9.    DNARROW  = #80;
  10.    PAGEUP   = #73;
  11.    PAGEDN   = #81;
  12.    HOMEKEY  = #71;
  13.    ENDKEY   = #79;
  14.    ENTER    = #13;
  15.    NUMITEMS = 4;
  16.    StrLen   = 14;
  17.    ListArray : array[1..NUMITEMS] of string[StrLen] =
  18.       ('Apples',
  19.        'Oranges',
  20.        'Bananas',
  21.        'Cumquats');
  22.  
  23. var
  24.    Ch: char;
  25.    CurrPos, OldPos: byte;
  26.  
  27. PROCEDURE InitMenuBox(x,y: byte);
  28. var
  29.    I: byte;
  30.  
  31. begin
  32.    Window(x,y,x+StrLen,y+NUMITEMS-1);
  33.    TextAttr := $70;
  34.    ClrScr;
  35.    for I := 1 to NUMITEMS do begin
  36.       GotoXY(1,I);
  37.       Write(' ',ListArray[I]);
  38.    end;
  39.    CurrPos := 1;
  40. end;
  41.  
  42. PROCEDURE GetKey(var Ch: char);
  43. begin
  44.    Ch := UpCase(ReadKey);
  45.    if Ch = #0 then Ch := UpCase(ReadKey);
  46. end;
  47.  
  48. PROCEDURE WriteString(Place,Attr: byte);
  49. begin
  50.    GotoXY(1,Place);
  51.    TextAttr := Attr;
  52.    ClrEol;
  53.    Write(' ',ListArray[Place]);
  54. end;
  55.  
  56. BEGIN
  57.    InitMenuBox(10,3);
  58.    repeat
  59.       OldPos := CurrPos;
  60.       WriteString(CurrPos,$30);
  61.       GetKey(Ch);
  62.       case Ch of
  63.          UPARROW: if CurrPos > 1 then Dec(CurrPos) else CurrPos := NUMITEMS;
  64.          DNARROW: if CurrPos < NUMITEMS then Inc(CurrPos) else CurrPos := 1;
  65.          PAGEUP : CurrPos := 1;
  66.          PAGEDN : CurrPos := NUMITEMS;
  67.          HOMEKEY: CurrPos := 1;
  68.          ENDKEY : CurrPos := NUMITEMS;
  69.          ENTER  : case CurrPos of
  70.                      1: {Apples};
  71.                      2: {Oranges};
  72.                      3: {Bananas};
  73.                      4: {Cumquats};
  74.                   end;
  75.            else ;
  76.       end;
  77.       WriteString(OldPos,$70);
  78.    until Ch = #27;
  79.    Window(1,1,80,25);
  80.    TextAttr := $07;
  81.    ClrScr;
  82. END.
  83. {============================================================================}
  84.